Developer CD Series 1992 June: ROMin Holiday

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / Generalized LISP / Glisp 1.2 / Source files / Scanner.glisp < prev

Wrap

Text File | 1990-08-15 | 9.3 KB | 308 lines | [TEXT/CCL ]

~---------------------------------------------------------------------------------------~ ~ Glisp scanner definition ~ ~---------------------------------------------------------------------------------------~ -Mlisp- export('( \! \@ \# \$ \% \^ \& \*  \_ \+ \- \= \{ \} \[ \] \: \" \; \' \< \> \? \, \. \/ \~ \` \| \\ \:\= \<\= \>\= \/\= ~ option characters \¡ \™ \£ \¢ \∞ \§ \¶ \• \ª \º \– \≠ \∑ \´ \® \† \¥ \¨ \^ \π \“ \‘ \∂ \ƒ \© \Δ \¬ \… \Ω \≈ \√ \∫ \µ \≤ \≥ \÷ \« \° \— \± \∏ \” \’ \ \◊ \¿ \» \æ \œ \ç \ø \å \ß \Æ \Œ \Ç \Ø \Å ), `:glisp); global `*lisp-readtable*, `*glisp-readtable*, `*glisp-sexp-readtable* ; ~---------------------------------------------------------------------------------------~ ~ Glisp character set ~ ~---------------------------------------------------------------------------------------~ `#| Letters a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ! ? _ & ~ special characters for use in names æ œ ç ø å ß ~ non-Greek international letters (ß is German) Æ Œ Ç Ø Å \<anything> Digits 0 1 2 3 4 5 6 7 8 9 ~ same as Common Lisp Special characters Delimiters @ # $ % ^ * ( ) + - = { } [ ] : ; ' < > , . / | Letters ! & _ ? Comment ~ String " Glisp-to-Lisp ` \ Option-character letters æ œ ç ø å ß Æ Œ Ç Ø Å Option-character delimiters ¡ ™ £ ¢ ∞ § ¶ • ª º – ≠ ∑ ´ ® † ¥ ¨ ^ π “ ‘ ∂ ƒ © Δ ¬ … Ω ≈ √ ∫ µ ≤ ≥ ÷ « ° — ± ∏ ” ’  ◊ ¿ » String " ... " ~ same as Common Lisp Comment ~ ... <newline> ~ Common Lisp's is: ; ... <newline> Interface to Lisp ` <s-expression> ~ ` also has its usual Common Lisp meanings The international characters æ œ ç ø å ß Æ Œ Ç Ø Å and the special characters ! ? _ & are considered to be LETTERS, not DELIMITERS. |# nil; ~ the 'nil' is to keep the Lisp reader from getting confused ~---------------------------------------------------------------------------------------~ ~ Glisp scanner ~ ~---------------------------------------------------------------------------------------~ `*lisp-readtable* := `*readtable* ; ~ the standard Common Lisp readtable `*glisp-readtable* := `copy-readtable(nil); ~ start Glisp out the same as Common Lisp for c in ~ additional letters: '(\! \? \_ \& ~ special symbols \æ \œ \ç \ø \å \ß ~ international letters \Æ \Œ \Ç \Ø \Å ) do `set-syntax-from-char( character(c), `#\z, ~ logically equivalent to 'z' `*glisp-readtable*, `*lisp-readtable*); for c in ~ additional props for some delimiters '( \@ \# \$ \% \^ \*  \+ \- \= \{ \} \[ \] \: \" \; \' \< \> \, \. \/ \~ \` \| \\ \¡ \™ \£ \¢ \∞ \§ \¶ \• \ª \º \– \≠ \∑ \´ \® \† \¥ \¨ \^ \π \“ \‘ \∂ \ƒ \© \Δ \¬ \… \Ω \≈ \√ \∫ \µ \≤ \≥ \÷ \« \° \— \± \∏ \” \’ \ \◊ \¿ \» ) do begin c.delimiter := t; if c member '(\" \~ \` \\) then ~ these are handled specially return nil; `set-syntax-from-char( character(c), `#\, , ~ logically equivalent to a comma `*glisp-readtable*, `*lisp-readtable*); eval {'`set-macro-character, ~ single character reader character(c), `(function (lambda (stream char) (quote ,c))), nil, ~ terminating macro character `*glisp-readtable* }; end; for c in ~ other delimiters {!eof, '\:\=, '\<\=, '\>\=, '\/\= } ~ end-of-file and 2-character delimiters do c.delimiter := t; `set-dispatch-macro-character( ~ make #$ be a reader macro in Lisp `#\#, `#\$, function(lambda (stream, char, x) = {'vEval, pVariable(read(stream, nil, !eof, t), t)}), `*lisp-readtable*); `set-syntax-from-char( ~ ~ = comment character: `#\~ , ~ ~ ... <end-of-line> `#\; , `*glisp-readtable*, `*lisp-readtable*); `set-macro-character( ~ ` = interface to Lisp: `#\` , ~ `<Lisp s-expression> function(lambda (stream, x) = begin `unread-char(`#\`, stream); ~ put the ` back x := lispRead(stream, nil, !eof, nil); ~ and let Lisp read it if consp(x) and car(x) eq 'quote and consp(cdr x) and null cddr(x) then x := cadr(x); return x; end), nil, ~ terminating macro character `*glisp-readtable*); `set-macro-character( ~ treat := as a single atom `#\: , function(lambda (stream, char) = if `char=(`peek-char(nil, stream, nil, !eofchar, t), `#\=) then `read-char(stream, nil, !eofchar, t) also '\:\= else '\:), nil, ~ terminating macro character `*glisp-readtable*); `set-macro-character( ~ treat <= as a single atom `#\< , function(lambda (stream, char) = if `char=(`peek-char(nil, stream, nil, !eofchar, t), `#\=) then `read-char(stream, nil, !eofchar, t) also '\<\= else '\<), nil, ~ terminating macro character `*glisp-readtable*); `set-macro-character( ~ treat >= as a single atom `#\> , function(lambda (stream, char) = if `char=(`peek-char(nil, stream, nil, !eofchar, t), `#\=) then `read-char(stream, nil, !eofchar, t) also '\>\= else '\>), nil, ~ terminating macro character `*glisp-readtable*); `set-macro-character( ~ treat /= as a single atom `#\/ , function(lambda (stream, char) = if `char=(`peek-char(nil, stream, nil, !eofchar, t), `#\=) then `read-char(stream, nil, !eofchar, t) also '\/\= else '\/), nil, ~ terminating macro character `*glisp-readtable*); `set-macro-character( ~ ^ -> expt `#\^ , function(lambda (stream, char) = 'expt), nil, ~ terminating macro character `*glisp-readtable*); ~---------------------------------------------------------------------------------------~ ~ Glisp s-expression reader ~ ~---------------------------------------------------------------------------------------~ ~ ~ Reads an s-expression consisting of Glisp tokens. The structure of the s-expression ~ conforms to Lisp's definition. `*glisp-sexp-readtable* := `copy-readtable(`*glisp-readtable*); `set-syntax-from-char(`#\(, `#\(, `*glisp-sexp-readtable*, `*lisp-readtable*); ~`set-syntax-from-char(`#\., `#\., `*glisp-sexp-readtable*, `*lisp-readtable*); `set-macro-character( `#\( , `get-macro-character(`#\(, `*lisp-readtable*), nil, ~ terminating macro character `*glisp-sexp-readtable*); ~---------------------------------------------------------------------------------------~ ~ Symbols ~ ~---------------------------------------------------------------------------------------~ ~ ~ associative functions: a + b + c -> (+ a b c) ~ these may take any number of arguments; nested calls are linearized for sym in '`( + - * / AND OR APPEND NCONC = /= < <= > >= CHAR< CHAR<= CHAR> CHAR>= CHAR= CHAR-EQUAL CHAR-LESSP CHAR-GREATERP CHAR/= CHAR-NOT-EQUAL CHAR-NOT-LESSP CHAR-NOT-GREATERP STRING< STRING<= STRING> STRING>= STRING= STRING-EQUAL STRING-LESSP STRING-GREATERP STRING/= STRING-NOT-EQUAL STRING-NOT-LESSP STRING-NOT-GREATERP ) do sym.associative := t; ~ prefix functions: not x -> (not x) ~ all take exactly one argument with no optionals ~ functions declared 'prefix' may be used without parentheses around their argument for sym in '( ~ a few common ones (users can declare others) \+ \- NOT NULL ATOM EVAL GO ~ all car/cdr list selectors CAR CAAAAR FIRST CDR CAAADR SECOND CAAR CAADAR THIRD CADR CAADDR FOURTH CDAR CADAAR FIFTH CDDR CADADR SIXTH CAAAR CADDAR SEVENTH CAADR CADDDR EIGHT CADAR CDAAAR NINTH CADDR CDAADR TENTH CDAAR CDADAR REST CDADR CDADDR CDDAR CDDAAR CDDDR CDDADR CDDDAR CDDDDR ) do sym.prefix := t; ~---------------------------------------------------------------------------------------~ ~ Operator precedence rules ~ ~---------------------------------------------------------------------------------------~ ~ ~ Assign left and right binding powers to selected infix operators. ~ Infix operators not explicitly assigned have the default binding powers. ~ If the left binding power is less than the right, the operator is left associative; ~ e.g. a - b + c -> (+ (- a b) c) ~ but a cons b cons c -> (cons a (cons b c)) for l in '`( (1001 0 \:= SET SETQ SETF PSETQ) (800 850 EXPT) (700 750 * /) (600 650 + -) (500 550 DEFAULT) (450 400 CONS APPEND REVAPPEND NCONC NRECONC CAT CONCATENATE) (300 350 = EQ EQL EQUAL EQUALP /= NEQ NEQL NEQUAL NEQUALP < <= > >= CHAR< CHAR<= CHAR> CHAR>= CHAR= CHAR-EQUAL CHAR-LESSP CHAR-GREATERP CHAR/= CHAR-NOT-EQUAL CHAR-NOT-LESSP CHAR-NOT-GREATERP STRING< STRING<= STRING> STRING>= STRING= STRING-EQUAL STRING-LESSP STRING-GREATERP STRING/= STRING-NOT-EQUAL STRING-NOT-LESSP STRING-NOT-GREATERP) (200 250 AND) (100 150 OR) ) do for sym in cddr(l) do sym.left := first(l) also sym.right := second(l);